home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / basic3 / pro5 / pcalnder.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1979-12-31  |  8.8 KB  |  226 lines
  1. 100  REM A PERPETUAL CALENDAR
  2. 105  WIDTH 80
  3. 110  REM IBM BASIC
  4. 120  K$=" ":DIM D$(35):V$=CHR$(124):GOTO 180
  5. 130  PRINT STRING$(70,45):RETURN
  6. 140  LPRINT STRING$(70,45):RETURN
  7. 150  CLS:FOR X=1 TO 10:PRINT:NEXT X:RETURN
  8. 160  PRINT:INPUT "Press >RETURN<  (Q to quit)  ",R$:IF R$="Q" THEN 170 ELSE RETURN
  9. 170  GOSUB 150:GOSUB 130:PRINT TAB(33)"End.":GOSUB 130:END
  10. 180  GOSUB 150:PRINT TAB(24)"A PERPETUAL CALENDAR":PRINT TAB(24)"********************"
  11. 190  PRINT:PRINT:INPUT "Which year?                               ",Y:YEAR=Y
  12. 200  INPUT "Which month? (type complete word)         ",MONTH$
  13. 210  GOSUB 130:INPUT "Printout?  (Y/N)   ",PR$:D=1:M=0
  14. 220  IF MONTH$="JANUARY" THEN M=1
  15. 230  IF MONTH$="FEBRUARY" THEN M=2
  16. 240  IF MONTH$="MARCH" THEN M=3
  17. 250  IF MONTH$="APRIL" THEN M=4
  18. 260  IF MONTH$="MAY" THEN M=5
  19. 270  IF MONTH$="JUNE" THEN M=6
  20. 280  IF MONTH$="JULY" THEN M=7
  21. 290  IF MONTH$="AUGUST" THEN M=8
  22. 300  IF MONTH$="SEPTEMBER" THEN M=9
  23. 310  IF MONTH$="OCTOBER" THEN M=10
  24. 320  IF MONTH$="NOVEMBER" THEN M=11
  25. 330  IF MONTH$="DECEMBER" THEN M=12
  26. 335  IF M=0 THEN 200
  27. 340  ON M GOTO 350,360,370,380,390,400,410,420,430,440,450,460
  28. 350  E=D:GOTO 470
  29. 360  E=D+31:GOTO 470
  30. 370  E=D+59:GOTO 470
  31. 380  E=D+90:GOTO 470
  32. 390  E=D+120:GOTO 470
  33. 400  E=D+151:GOTO 470
  34. 410  E=D+181:GOTO 470
  35. 420  E=D+212:GOTO 470
  36. 430  E=D+243:GOTO 470
  37. 440  E=D+273:GOTO 470
  38. 450  E=D+304:GOTO 470
  39. 460  E=D+334
  40. 470  Z=Y/4:A=INT(Z):Z=Z-A:IF Z=0 THEN 480 ELSE 490
  41. 480  IF M>2 THEN E=E+1 ELSE E=E
  42. 490  B=(Y-1)/4:B=INT(B):C=(Y-1)/100:C=INT(C):F=(Y-1)/400:F=INT(F)
  43. 500  G=E+Y+B-C+F:H=G/7:I=INT(H):I=H-I:I=I*7:GOSUB 150:GOSUB 130
  44. 510  IF I<1 AND I>0.5 THEN 580
  45. 520  IF I<2 AND I>1.5 THEN 700
  46. 530  IF I<3 AND I>2.5 THEN 820
  47. 540  IF I<4.5 AND I>4 THEN 940
  48. 550  IF I<5.5 AND I>5 THEN 1060
  49. 560  IF I<6.5 AND I>6 THEN 1180
  50. 570  IF I=0 THEN 1300
  51. 580  D$(1)="1":D$(2)="2":D$(3)="3":D$(4)="4":D$(5)="5":D$(6)="6":D$(7)="7"
  52. 590  D$(8)="8":D$(9)="9":D$(10)="10":D$(11)="11":D$(12)="12":D$(13)="13"
  53. 600  D$(14)="14":D$(15)="15":D$(16)="16":D$(17)="17":D$(18)="18":D$(19)="19"
  54. 610  D$(20)="20":D$(21)="21":D$(22)="22":D$(23)="23":D$(24)="24":D$(25)="25"
  55. 620  D$(26)="26":D$(27)="27":D$(28)="28":D$(29)="29":D$(30)="30":D$(31)="31"
  56. 630  D$(32)=K$:D$(33)=K$:D$(34)=K$:D$(35)=K$
  57. 640  IF M=4 OR M=6 OR M=9 OR M=11 THEN 690 ELSE 650
  58. 650  IF M=2 THEN 660 ELSE 1420
  59. 660  IF Z=0 THEN 670 ELSE 680
  60. 670  D$(30)=K$:D$(31)=K$:GOTO 1420
  61. 680  D$(29)=K$:D$(30)=K$:D$(31)=K$:GOTO 1420
  62. 690  D$(31)=K$:GOTO 1420
  63. 700  D$(1)=K$:D$(2)="1":D$(3)="2":D$(4)="3":D$(5)="4":D$(6)="5":D$(7)="6"
  64. 710  D$(8)="7":D$(9)="8":D$(10)="9":D$(11)="10":D$(12)="11":D$(13)="12"
  65. 720  D$(14)="13":D$(15)="14":D$(16)="15":D$(17)="16":D$(18)="17":D$(19)="18"
  66. 730  D$(20)="19":D$(21)="20":D$(22)="21":D$(23)="22":D$(24)="23":D$(25)="24"
  67. 740  D$(26)="25":D$(27)="26":D$(28)="27":D$(29)="28":D$(30)="29":D$(31)="30"
  68. 750  D$(32)="31":D$(33)=K$:D$(34)=K$:D$(35)=K$
  69. 760  IF M=4 OR M=6 OR M=9 OR M=11 THEN 810 ELSE 770
  70. 770  IF M=2 THEN 780 ELSE 1420
  71. 780  IF Z=0 THEN 790 ELSE 800
  72. 790  D$(31)=K$:D$(32)=K$:GOTO 1420
  73. 800  D$(30)=K$:D$(31)=K$:D$(32)=K$:GOTO 1420
  74. 810  D$(32)=K$:GOTO 1420
  75. 820  D$(1)=K$:D$(2)=K$:D$(3)="1":D$(4)="2":D$(5)="3":D$(6)="4":D$(7)="5"
  76. 830  D$(8)="6":D$(9)="7":D$(10)="8":D$(11)="9":D$(12)="10":D$(13)="11"
  77. 840  D$(14)="12":D$(15)="13":D$(16)="14":D$(17)="15":D$(18)="16":D$(19)="17"
  78. 850  D$(20)="18":D$(21)="19":D$(22)="20":D$(23)="21":D$(24)="22":D$(25)="23"
  79. 860  D$(26)="24":D$(27)="25":D$(28)="26":D$(29)="27":D$(30)="28":D$(31)="29"
  80. 870  D$(32)="30":D$(33)="31":D$(34)=K$:D$(35)=K$
  81. 880  IF M=4 OR M=6 OR M=9 OR M=11 THEN 930 ELSE 890
  82. 890  IF M=2 THEN 900 ELSE 1420
  83. 900  IF Z=0 THEN 910 ELSE 920
  84. 910  D$(32)=K$:D$(33)=K$:GOTO 1420
  85. 920  D$(31)=K$:D$(32)=K$:D$(33)=K$:GOTO 1420
  86. 930  D$(33)=K$:GOTO 1420
  87. 940  D$(1)=K$:D$(2)=K$:D$(3)=K$:D$(4)="1":D$(5)="2":D$(6)="3":D$(7)="4"
  88. 950  D$(8)="5":D$(9)="6":D$(10)="7":D$(11)="8":D$(12)="9":D$(13)="10"
  89. 960  D$(14)="11":D$(15)="12":D$(16)="13":D$(17)="14":D$(18)="15":D$(19)="16"
  90. 970  D$(20)="17":D$(21)="18":D$(22)="19":D$(23)="20":D$(24)="21":D$(25)="22"
  91. 980  D$(26)="23":D$(27)="24":D$(28)="25":D$(29)="26":D$(30)="27":D$(31)="28"
  92. 990  D$(32)="29":D$(33)="30":D$(34)="31":D$(35)=K$
  93. 1000  IF M=4 OR M=6 OR M=9 OR M=11 THEN 1050 ELSE 1010
  94. 1010  IF M=2 THEN 1020 ELSE 1420
  95. 1020  IF Z=0 THEN 1030 ELSE 1040
  96. 1030  D$(33)=K$:D$(34)=K$:GOTO 1420
  97. 1040  D$(32)=K$:D$(33)=K$:D$(34)=K$:GOTO 1420
  98. 1050  D$(34)=K$:GOTO 1420
  99. 1060  D$(1)=K$:D$(2)=K$:D$(3)=K$:D$(4)=K$:D$(5)="1":D$(6)="2":D$(7)="3"
  100. 1070  D$(8)="4":D$(9)="5":D$(10)="6":D$(11)="7":D$(12)="8":D$(13)="9"
  101. 1080  D$(14)="10":D$(15)="11":D$(16)="12":D$(17)="13":D$(18)="14":D$(19)="15"
  102. 1090  D$(20)="16":D$(21)="17":D$(22)="18":D$(23)="19":D$(24)="20":D$(25)="21"
  103. 1100  D$(26)="22":D$(27)="23":D$(28)="24":D$(29)="25":D$(30)="26":D$(31)="27"
  104. 1110  D$(32)="28":D$(33)="29":D$(34)="30":D$(35)="31"
  105. 1120  IF M=4 OR M=6 OR M=9 OR M=11 THEN 1170 ELSE 1130
  106. 1130  IF M=2 THEN 1140 ELSE 1420
  107. 1140  IF Z=0 THEN 1150 ELSE 1160
  108. 1150  D$(34)=K$:D$(35)=K$:GOTO 1420
  109. 1160  D$(33)=K$:D$(34)=K$:D$(35)=K$:GOTO 1420
  110. 1170  D$(35)=K$:GOTO 1420
  111. 1180  D$(1)=K$:D$(2)=K$:D$(3)=K$:D$(4)=K$:D$(5)=K$:D$(6)="1":D$(7)="2"
  112. 1190  D$(8)="3":D$(9)="4":D$(10)="5":D$(11)="6":D$(12)="7":D$(13)="8"
  113. 1200  D$(14)="9":D$(15)="10":D$(16)="11":D$(17)="12":D$(18)="13":D$(19)="14"
  114. 1210  D$(20)="15":D$(21)="16":D$(22)="17":D$(23)="18":D$(24)="19":D$(25)="20"
  115. 1220  D$(26)="21":D$(27)="22":D$(28)="23":D$(29)="24/31":D$(30)="25":D$(31)="26"
  116. 1230  D$(32)="27":D$(33)="28":D$(34)="29":D$(35)="30"
  117. 1240  IF M=4 OR M=6 OR M=9 OR M=11 THEN 1290 ELSE 1250
  118. 1250  IF M=2 THEN 1260 ELSE 1420
  119. 1260  IF Z=0 THEN 1270 ELSE 1280
  120. 1270  D$(29)="24":D$(35)=K$:=K$:GOTO 1420
  121. 1280  D$(29)="24":D$(34)=K$:D$(35)=K$:GOTO 1420
  122. 1290  D$(29)="24":GOTO 1420
  123. 1300  D$(1)=K$:D$(2)=K$:D$(3)=K$:D$(4)=K$:D$(5)=K$:D$(6)=K$:D$(7)="1"
  124. 1310  D$(8)="2":D$(9)="3":D$(10)="4":D$(11)="5":D$(12)="6":D$(13)="7"
  125. 1320  D$(14)="8":D$(15)="9":D$(16)="10":D$(17)="11":D$(18)="12":D$(19)="13"
  126. 1330  D$(20)="14":D$(21)="15":D$(22)="16":D$(23)="17":D$(24)="18":D$(25)="19"
  127. 1340  D$(26)="20":D$(27)="21":D$(28)="22":D$(29)="23/30":D$(30)="24/31":D$(31)="25"
  128. 1350  D$(32)="26":D$(33)="27":D$(34)="28":D$(35)="29"
  129. 1360  IF M=4 OR M=6 OR M=9 OR M=11 THEN 1410 ELSE 1370
  130. 1370  IF M=2 THEN 1380 ELSE 1420
  131. 1380  IF Z=0 THEN 1390 ELSE 1400
  132. 1390  D$(29)="23":D$(30)="24":GOTO 1420
  133. 1400  D$(29)="23":D$(30)="24":D$(35)=K$:GOTO 1420
  134. 1410  D$(30)="24":GOTO 1420
  135. 1420  GOSUB 150:PRINT"Calendar for ";MONTH$;" ";YEAR
  136. 1430  GOSUB 130
  137. 1440  PRINT V$;TAB(3)"SUNDAY";TAB(10)V$;TAB(13)"MONDAY";TAB(20)V$;TAB(22)"TUESDAY";
  138. 1450  PRINT TAB(30)V$;TAB(31)"WEDNESDAY";TAB(40)V$;TAB(42)"THURSDAY";TAB(50)V$;
  139. 1460  PRINT TAB(53)"FRIDAY";TAB(60)V$;TAB(62)"SATURDAY";TAB(70)V$:GOSUB 130
  140. 1470  PRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  141. 1480  PRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  142. 1490  PRINT V$;TAB(5)D$(1);TAB(10)V$;TAB(15)D$(2);
  143. 1500  PRINT TAB(20)V$;TAB(25)D$(3);TAB(30)V$;TAB(35)D$(4);
  144. 1510  PRINT TAB(40)V$;TAB(45)D$(5);TAB(50)V$;
  145. 1520  PRINT TAB(55)D$(6);TAB(60)V$;TAB(65)D$(7);TAB(70)V$
  146. 1530  PRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  147. 1540  PRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  148. 1550  GOSUB 130:PRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  149. 1560  PRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  150. 1570  PRINT V$;TAB(5)D$(8);TAB(10)V$;TAB(15)D$(9);
  151. 1580  PRINT TAB(20)V$;TAB(24)D$(10);TAB(30)V$;TAB(34)D$(11);
  152. 1590  PRINT TAB(40)V$;TAB(44)D$(12);TAB(50)V$;
  153. 1600  PRINT TAB(54)D$(13);TAB(60)V$;TAB(64)D$(14);TAB(70)V$
  154. 1610  PRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  155. 1620  PRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  156. 1630  GOSUB 130:PRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  157. 1640  PRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  158. 1650  PRINT V$;TAB(4)D$(15);TAB(10)V$;TAB(14)D$(16);
  159. 1660  PRINT TAB(20)V$;TAB(24)D$(17);TAB(30)V$;TAB(34)D$(18);
  160. 1670  PRINT TAB(40)V$;TAB(44)D$(19);TAB(50)V$;
  161. 1680  PRINT TAB(54)D$(20);TAB(60)V$;TAB(64)D$(21);TAB(70)V$
  162. 1690  PRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  163. 1700  PRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  164. 1710  GOSUB 130:PRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  165. 1720  PRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  166. 1730  PRINT V$;TAB(4)D$(22);TAB(10)V$;TAB(14)D$(23);
  167. 1740  PRINT TAB(20)V$;TAB(24)D$(24);TAB(30)V$;TAB(34)D$(25);
  168. 1750  PRINT TAB(40)V$;TAB(44)D$(26);TAB(50)V$;
  169. 1760  PRINT TAB(54)D$(27);TAB(60)V$;TAB(64)D$(28);TAB(70)V$
  170. 1770  PRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  171. 1780  PRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  172. 1790  GOSUB 130:PRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  173. 1800  PRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  174. 1810  PRINT V$;TAB(4)D$(29);TAB(10)V$;TAB(14)D$(30);
  175. 1820  PRINT TAB(20)V$;TAB(24)D$(31);TAB(30)V$;TAB(34)D$(32);
  176. 1830  PRINT TAB(40)V$;TAB(44)D$(33);TAB(50)V$;TAB(54)D$(34);
  177. 1840  PRINT TAB(60)V$;TAB(64)D$(35);TAB(70)V$
  178. 1850  PRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  179. 1860  PRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$:GOSUB 130:GOTO 1870
  180. 1870  IF PR$="Y" THEN 1880 ELSE END
  181. 1880  LPRINT "Calendar for ";MONTH$;" ";YEAR
  182. 1890  GOSUB 140
  183. 1900  LPRINT V$;TAB(3)"SUNDAY";TAB(10)V$;TAB(13)"MONDAY";TAB(20)V$;TAB(22)"TUESDAY";
  184. 1910  LPRINT TAB(30)V$;TAB(31)"WEDNESDAY";TAB(40)V$;TAB(42)"THURSDAY";TAB(50)V$;
  185. 1920  LPRINT TAB(53)"FRIDAY";TAB(60)V$;TAB(62)"SATURDAY";TAB(70)V$:GOSUB 140
  186. 1930  LPRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  187. 1940  LPRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  188. 1950  LPRINT V$;TAB(5)D$(1);TAB(10)V$;TAB(15)D$(2);
  189. 1960  LPRINT TAB(20)V$;TAB(25)D$(3);TAB(30)V$;TAB(35)D$(4);
  190. 1970  LPRINT TAB(40)V$;TAB(45)D$(5);TAB(50)V$;
  191. 1980  LPRINT TAB(55)D$(6);TAB(60)V$;TAB(65)D$(7);TAB(70)V$
  192. 1990  LPRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  193. 2000  LPRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  194. 2010  GOSUB 140:LPRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  195. 2020  LPRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  196. 2030  LPRINT V$;TAB(5)D$(8);TAB(10)V$;TAB(15)D$(9);
  197. 2040  LPRINT TAB(20)V$;TAB(24)D$(10);TAB(30)V$;TAB(34)D$(11);
  198. 2050  LPRINT TAB(40)V$;TAB(44)D$(12);TAB(50)V$;
  199. 2060  LPRINT TAB(54)D$(13);TAB(60)V$;TAB(64)D$(14);TAB(70)V$
  200. 2070  LPRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  201. 2080  LPRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  202. 2090  GOSUB 140:LPRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  203. 2100  LPRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  204. 2110  LPRINT V$;TAB(4)D$(15);TAB(10)V$;TAB(14)D$(16);
  205. 2120  LPRINT TAB(20)V$;TAB(24)D$(17);TAB(30)V$;TAB(34)D$(18);
  206. 2130  LPRINT TAB(40)V$;TAB(44)D$(19);TAB(50)V$;
  207. 2140  LPRINT TAB(54)D$(20);TAB(60)V$;TAB(64)D$(21);TAB(70)V$
  208. 2150  LPRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  209. 2160  LPRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  210. 2170  GOSUB 140:LPRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  211. 2180  LPRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  212. 2190  LPRINT V$;TAB(4)D$(22);TAB(10)V$;TAB(14)D$(23);
  213. 2200  LPRINT TAB(20)V$;TAB(24)D$(24);TAB(30)V$;TAB(34)D$(25);
  214. 2210  LPRINT TAB(40)V$;TAB(44)D$(26);TAB(50)V$;
  215. 2220  LPRINT TAB(54)D$(27);TAB(60)V$;TAB(64)D$(28);TAB(70)V$
  216. 2230  LPRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  217. 2240  LPRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  218. 2250  GOSUB 140:LPRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  219. 2260  LPRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$
  220. 2270  LPRINT V$;TAB(4)D$(29);TAB(10)V$;TAB(14)D$(30);
  221. 2280  LPRINT TAB(20)V$;TAB(24)D$(31);TAB(30)V$;TAB(34)D$(32);
  222. 2290  LPRINT TAB(40)V$;TAB(44)D$(33);TAB(50)V$;TAB(54)D$(34);
  223. 2300  LPRINT TAB(60)V$;TAB(64)D$(35);TAB(70)V$
  224. 2310  LPRINT V$;TAB(10)V$;TAB(20)V$;TAB(30)V$;
  225. 2320  LPRINT TAB(40)V$;TAB(50)V$;TAB(60)V$;TAB(70)V$:GOSUB 140
  226.